home *** CD-ROM | disk | FTP | other *** search
/ Aminet 39 / Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso / Aminet / dev / basic / pmDevBas.lha / Layout.bas < prev    next >
Encoding:
BASIC Source File  |  2000-06-13  |  11.4 KB  |  448 lines
  1. ' *********************************************************************
  2. '       Layout © 1996-99 by Henrik Isaksson -- All Rights Reserved
  3. '                           V. 1.0 (16.07.99)
  4. '
  5. '                 C to HBASIC conversion 1.0 (12.6.00)
  6. '               by Dámaso D. Estévez <amidde@arrakis.es>
  7. '              AmiSpaTra - http://www.arrakis.es/~amidde/
  8. '
  9. '     This example shows how to create groups like the C version...
  10. '      except what with this version };) the Quit item works.
  11. '           Este ejemplo muestra cómo crear grupos igual que
  12. '                 en la versión en C... salvo que con
  13. '           esta versión };) el ítem Quit (Salir) funciona.
  14. ' *********************************************************************
  15.  
  16. REM $include pm.bh
  17. REM $include exec.bh
  18. REM $include intuition.bh
  19. REM $include utility.bc
  20.  
  21. pmb&  = NULL&    ' PopUpMenuBase
  22. ib&   = NULL&    ' IntuitionBase
  23. gb&   = NULL&    ' GfxBase
  24. w&    = NULL&    ' Window
  25. im&   = NULL&    ' IntuiMessage
  26. p&    = NULL&    ' PopupMenu
  27. r&    = TRUE&    ' Status flag (loop) / Bandera de estado (bucle)
  28. ok&   = FALSE&   ' Status flag / Bandera de estado
  29.  
  30. DIM wtags&(20)   ' Window Taglist / Lista de atributos para la ventana
  31.  
  32. ' My function / Mi función
  33. ' ------------------------
  34. DECLARE FUNCTION MakeTestMenu&()
  35.  
  36. ' =====================================================================
  37. '                          The code / El código
  38. ' ====================================================================
  39.  
  40. '            "Opening" all libraries needed
  41. ' Abriendo y preparando todas las bibliotecas necesarias
  42. ' ------------------------------------------------------
  43.  
  44. LIBRARY OPEN "exec.library"
  45. LIBRARY OPEN "popupmenu.library",POPUPMENU_VERSION&
  46.  
  47. pmb&=LIBRARY("popupmenu.library")
  48.  
  49. IF pmb& <> NULL& THEN
  50.     LIBRARY VARPTR "popupmenu.library", pmb&
  51.     ib& = PEEKL(pmb& + pmb_IntuitionBase%)
  52.     IF ib& <> NULL& THEN
  53.         LIBRARY VARPTR "intuition.library", ib&
  54.         gb& = PEEKL(pmb& + pmb_GfxBase%)
  55.         IF gb& <> NULL& THEN
  56.             LIBRARY VARPTR "graphics.library", gb&
  57.             ok& = TRUE&
  58.         END IF
  59.     END IF
  60. END IF
  61.  
  62. IF ok& = TRUE& THEN
  63.  
  64.     ' Preparing my menu / Preparando mi menú
  65.     ' --------------------------------------
  66.     p& = MakeTestMenu&()
  67.  
  68.     IF p& <> NULL& THEN
  69.  
  70.         '   Window properties
  71.         ' Atributos de la ventana
  72.         ' -----------------------
  73.         TAGLIST VARPTR(wtags&(0)),_
  74.             WA_IDCMP&,       IDCMP_CLOSEWINDOW& OR IDCMP_MOUSEBUTTONS& OR IDCMP_VANILLAKEY, _
  75.             WA_RMBTrap&,     TRUE&, _
  76.             WA_DragBar&,     TRUE&, _
  77.             WA_Width&,       150, _
  78.             WA_Height&,      100, _
  79.             WA_Left&,        0, _
  80.             WA_Top&,         100, _
  81.             WA_Title&,       SADD("Layout"+CHR$(0)), _
  82.             WA_CloseGadget&, TRUE&,_
  83.             TAG_DONE&
  84.  
  85.         '    Opening the window: this window is only needed to find out
  86.         '  when AND where the MENU should appear AND wich SCREEN it's on.
  87.         ' Abriendo la ventana: sólo es necesaria para saber dónde y cuándo
  88.         '       el menú emergente debe aparecer y sobre qué pantalla.
  89.         ' ----------------------------------------------------------------
  90.         w& = OpenWindowTagList&(NULL&, VARPTR(wtags&(0)))
  91.  
  92.         IF w& <> NULL& THEN
  93.  
  94.             '  First, a C struct simulation (see the imsg var in original C code)
  95.             '      Primero, reservo espacio para simular una estructura en C
  96.             ' (consulte la función de la variable imsg en el código original en C)
  97.             ' --------------------------------------------------------------------
  98.             imsg$=STRING$(IntuiMessage_sizeof%,CHR$(0))
  99.  
  100.             '     Disabling Basic events :)
  101.             ' Desactivando eventos del Basic :)
  102.             ' ---------------------------------
  103.             REM $event OFF
  104.  
  105.             WHILE r&
  106.  
  107.                 '  Waiting a message
  108.                 ' Esperando un mensaje
  109.                 ' --------------------
  110.                 dummy& = WaitPort&(PEEKL(w&+UserPort%))
  111.  
  112.                 DO
  113.  
  114.                     '    Get the message
  115.                     ' Se obtiene el mensaje
  116.                     ' ---------------------
  117.                     im& = GetMsg&(PEEKL(w&+UserPort%))
  118.                     IF im& THEN
  119.  
  120.                         '   ... but we will work with a copy
  121.                         ' ... pero se trabajará con una copia
  122.                         ' -----------------------------------
  123.                         CopyMem im&, SADD(imsg$), IntuiMessage_sizeof%
  124.                         ReplyMsg im&
  125.  
  126.                         tmp& = PEEKL(SADD(imsg$)+Class%)
  127.  
  128.                         SELECT CASE tmp&
  129.  
  130.                                 CASE = IDCMP_MOUSEBUTTONS&
  131.  
  132.                                     TAGLIST VARPTR(tags&(0)), _
  133.                                         PM_Menu&,  p&, _
  134.                                         TAG_DONE&
  135.  
  136.                                     '  Opening finally my popupmenu menu
  137.                                     ' Abriendo finalmente mi menú emergente
  138.                                     ' -------------------------------------
  139.                                     r& = PM_OpenPopupMenuA&(w&, VARPTR(tags&(0))) - 2&
  140.  
  141.                                     EXIT DO
  142.  
  143.                                 CASE = IDCMP_CLOSEWINDOW&
  144.                                     r& = FALSE&
  145.                                     EXIT DO
  146.  
  147.                         END SELECT
  148.  
  149.                     ELSE
  150.  
  151.                         EXIT LOOP
  152.  
  153.                     END IF
  154.  
  155.                 LOOP
  156.  
  157.             WEND
  158.  
  159.             '    Reenabling Basic events :)
  160.             ' Reactivando eventos del Basic :)
  161.             ' --------------------------------
  162.             REM $event ON
  163.  
  164.             CloseWindow& w&
  165.  
  166.         ELSE
  167.  
  168.             PRINT "Window error!"
  169.  
  170.         END IF
  171.  
  172.         PM_FreePopupMenu& p&
  173.  
  174.     ELSE
  175.  
  176.         PRINT "Menu error!"
  177.  
  178.     END IF
  179.  
  180. ELSE
  181.  
  182.     PRINT "One or more libraries have failed!"
  183.  
  184. END IF
  185.  
  186. IF gb&  <> NULL& THEN LIBRARY VARPTR "graphics.library",  NULL&
  187. IF ib&  <> NULL& THEN LIBRARY VARPTR "intuition.library", NULL&
  188.  
  189. '          Safe, even if the program fails to open the libraries
  190. ' Método seguro, incluso aunque el programa falle al abrir las bibliotecas
  191. ' ------------------------------------------------------------------------
  192. LIBRARY CLOSE "popupmenu.library"
  193. LIBRARY CLOSE "exec.library"
  194.  
  195. END
  196.  
  197. ' =====================================================================
  198.  
  199. FUNCTION MakeTestMenu&()
  200. LOCAL i&,j&,pi1&,pi2&,mpi&,tags&
  201.  
  202. ' Taglist / Lista de atributos
  203. ' ----------------------------
  204. DIM tags&(28)
  205.  
  206. ' Items or menu pointer arrays / Matrices de punteros a ítems o menús
  207. ' -------------------------------------------------------------------
  208. DIM mpi&(7)     ' Main
  209. DIM pi1&(10)    ' Aux. first  level
  210. DIM pi2&(9)     ' Aux. second level
  211.  
  212.     ' ====================================
  213.     '     Menu header (PMMenu macro)
  214.     '   Cabecera del menú (macro PMMenu)
  215.     ' =====================================
  216.  
  217.     '   First menu item (not visible)
  218.     ' Primer ítem del menú (no visible)
  219.     ' ---------------------------------
  220.     TAGLIST VARPTR(tags&(0)), _
  221.         PM_Hidden&, TRUE&, _
  222.         TAG_DONE&
  223.  
  224.     mpi&(0) = PM_MakeItemA&(VARPTR(tags&(0)))
  225.  
  226.     '    Second menu item (title)
  227.     ' Segundo ítem del menú (título)
  228.     ' ------------------------------
  229.     TAGLIST VARPTR(tags&(0)),_
  230.         PM_Title&,SADD("Group Layout"+CHR$(0)), _
  231.         PM_NoSelect&, TRUE&, _
  232.         PM_ShinePen&, TRUE&, _
  233.         PM_Shadowed&, TRUE&, _
  234.         PM_Center&,   TRUE&, _
  235.         TAG_DONE&
  236.  
  237.     mpi&(1) = PM_MakeItemA&(VARPTR(tags&(0)))
  238.  
  239.     '     Third menu item (separator bar)
  240.     ' Tercer ítem del menú (barra separadora)
  241.     ' ---------------------------------------
  242.     TAGLIST VARPTR(tags&(0)), _
  243.         PM_WideTitleBar&, TRUE&, _
  244.         TAG_DONE&
  245.  
  246.     mpi&(2) = PM_MakeItemA&(VARPTR(tags&(0)))
  247.  
  248.     ' ===================================================================
  249.     ' The first horizontal group with three elements (one is other group)
  250.     ' El primer grupo horizontal con tres elementos (one is other group)
  251.     ' ===================================================================
  252.  
  253.     ' -------------------------------
  254.     ' First element / Primer elemento
  255.     '--------------------------------
  256.  
  257.     TAGLIST VARPTR (tags&(0)),_
  258.         PM_Title&,  SADD("Left"+CHR$(0)),_
  259.         PM_Center&, TRUE&,_
  260.         TAG_DONE&
  261.  
  262.     pi1&(1)= PM_MakeItemA&(VARPTR(tags&(0)))
  263.  
  264.     ' ------------------------------------
  265.     '  Second element (a vertical group)
  266.     ' Segundo elemento (un grupo vertical)
  267.     ' ------------------------------------
  268.  
  269.     FOR i&=1 TO 6
  270.  
  271.         ' Creating the six menu entries / Creando seis entradas de menú
  272.         ' -------------------------------------------------------------
  273.  
  274.         TAGLIST VARPTR (tags&(0)),_
  275.             PM_Title&,  SADD("Item"+RIGHT$(STR$(i&),LEN(STR$(i&))-1)++CHR$(0)),_
  276.             PM_Center&, TRUE&,_
  277.             TAG_DONE&
  278.  
  279.         pi2&(i&)= PM_MakeItemA&(VARPTR(tags&(0)))
  280.  
  281.     NEXT i&
  282.  
  283.     ' Now, vertical grouping... / Ahora, agrupación vertical...
  284.     ' ---------------------------------------------------------
  285.     TAGLIST VARPTR(tags&(0)),_
  286.         PM_Dummy&, 0&,_
  287.         PM_Item&,  pi2&(1), _
  288.         PM_Item&,  pi2&(2), _
  289.         PM_Item&,  pi2&(3), _
  290.         PM_Item&,  pi2&(4), _
  291.         PM_Item&,  pi2&(5), _
  292.         PM_Item&,  pi2&(6), _
  293.         TAG_DONE&
  294.  
  295.     pi2&(0) = PM_MakeMenuA&(VARPTR(tags&(0)))
  296.  
  297.     TAGLIST VARPTR(tags&(0)), _
  298.         PM_NoSelect&,   TRUE&, _
  299.         PM_LayoutMode&, PML_Vertical&, _
  300.         PM_Members&,    pi2&(0),_
  301.         TAG_DONE&
  302.  
  303.     pi1&(2) = PM_MakeItemA&(VARPTR(tags&(0)))
  304.  
  305.     ' -------------------------------
  306.     ' Third element / Tercer elemento
  307.     ' -------------------------------
  308.  
  309.     TAGLIST VARPTR (tags&(0)),_
  310.         PM_Title&,   SADD("Right"+CHR$(0)),_
  311.         PM_Center&, TRUE&,_
  312.         TAG_DONE&
  313.  
  314.     pi1&(3)= PM_MakeItemA&(VARPTR(tags&(0)))
  315.  
  316.     '  And now, horizontal grouping...
  317.     ' Y ahora, agrupación horizontal...
  318.     ' ---------------------------------
  319.     TAGLIST VARPTR(tags&(0)),_
  320.         PM_Dummy&, 0&,_
  321.         PM_Item&,  pi1&(1), _
  322.         PM_Item&,  pi1&(2), _
  323.         PM_Item&,  pi1&(3), _
  324.         TAG_DONE&
  325.  
  326.     pi1&(0) = PM_MakeMenuA&(VARPTR(tags&(0)))
  327.  
  328.     TAGLIST VARPTR(tags&(0)), _
  329.         PM_NoSelect&,   TRUE&, _
  330.         PM_LayoutMode&, PML_Horizontal&, _
  331.         PM_Members&,    pi1&(0),_
  332.         TAG_DONE&
  333.  
  334.     mpi&(3) = PM_MakeItemA&(VARPTR(tags&(0)))
  335.  
  336.     ' ================================
  337.     ' Separator bar / Barra separadora
  338.     ' ================================
  339.     TAGLIST VARPTR(tags&(0)), _
  340.         PM_TitleBar&, TRUE&, _
  341.         TAG_DONE&
  342.  
  343.     mpi&(4) = PM_MakeItemA&(VARPTR(tags&(0)))
  344.  
  345.     ' ====================================================
  346.     '   The second group (vertical)... this contains
  347.     '   five entries (horizontal groups with 10 items).
  348.     '   El segundo grupo (vertical)... contiene cinco
  349.     ' entradas (grupos horizontales de 10 ítems cada uno).
  350.     ' ====================================================
  351.  
  352.     FOR j& = 0 TO 4                        '  5 items (vertical)
  353.  
  354.         FOR i& = 0  TO 9                ' 10 items (horizontal)
  355.  
  356.             TAGLIST VARPTR (tags&(0)),_
  357.                 PM_ColourBox&, i&+(j&*10),_
  358.                 TAG_DONE&
  359.  
  360.             pi2&(i&)= PM_MakeItemA&(VARPTR(tags&(0)))
  361.  
  362.         NEXT i&
  363.  
  364.     ' Creating the horizontal group / Creación del grupo horizontal
  365.     ' -------------------------------------------------------------
  366.  
  367.         TAGLIST VARPTR(tags&(0)),_
  368.             PM_Dummy&, 0&,_
  369.             PM_Item&,  pi2&(1), _
  370.             PM_Item&,  pi2&(2), _
  371.             PM_Item&,  pi2&(3), _
  372.             PM_Item&,  pi2&(4), _
  373.             PM_Item&,  pi2&(5), _
  374.             PM_Item&,  pi2&(6), _
  375.             PM_Item&,  pi2&(7), _
  376.             PM_Item&,  pi2&(8), _
  377.             PM_Item&,  pi2&(9), _
  378.             PM_Item&,  pi2&(0), _
  379.             TAG_DONE&
  380.  
  381.         pi1&(6+j&) = PM_MakeMenuA&(VARPTR(tags&(0)))
  382.  
  383.         TAGLIST VARPTR(tags&(0)), _
  384.             PM_NoSelect&,   TRUE&, _
  385.             PM_LayoutMode&, PML_Horizontal&, _
  386.             PM_Members&,    pi1&(6+j&),_
  387.             TAG_DONE&
  388.  
  389.         pi1&(1+j&) = PM_MakeItemA&(VARPTR(tags&(0)))
  390.  
  391.     NEXT j&
  392.  
  393.     ' Creating the vertical group / Creación del grupo vertical
  394.     ' ---------------------------------------------------------
  395.     TAGLIST VARPTR(tags&(0)),_
  396.         PM_Dummy&, 0&,_
  397.         PM_Item&,  pi1&(1), _
  398.         PM_Item&,  pi1&(2), _
  399.         PM_Item&,  pi1&(3), _
  400.         PM_Item&,  pi1&(4), _
  401.         PM_Item&,  pi1&(5), _
  402.         TAG_DONE&
  403.  
  404.     pi1&(0) = PM_MakeMenuA&(VARPTR(tags&(0)))
  405.  
  406.     TAGLIST VARPTR(tags&(0)), _
  407.         PM_NoSelect&,   TRUE&, _
  408.         PM_LayoutMode&, PML_Vertical&, _
  409.         PM_Members&,    pi1&(0),_
  410.         TAG_DONE&
  411.  
  412.     mpi&(5) = PM_MakeItemA&(VARPTR(tags&(0)))
  413.  
  414.     ' ================================
  415.     ' Separator bar / Barra separadora
  416.     ' ================================
  417.     TAGLIST VARPTR(tags&(0)), _
  418.         PM_TitleBar&, TRUE&, _
  419.         TAG_DONE&
  420.  
  421.     mpi&(6) = PM_MakeItemA&(VARPTR(tags&(0)))
  422.  
  423.     ' =============================
  424.     ' Quit item / Ítem Quit (Salir)
  425.     ' =============================
  426.  
  427.     TAGLIST VARPTR(tags&(0)), _
  428.         PM_Title&,    SADD("Quit"+CHR$(0)), _
  429.         PM_UserData&, 2&, _
  430.         TAG_DONE&
  431.  
  432.     mpi&(7) = PM_MakeItemA&(VARPTR(tags&(0)))
  433.  
  434.     ' =========================
  435.     '  Creating the popup menu
  436.     ' Creando el menú emergente
  437.     ' =========================
  438.  
  439.     FOR i& = 0 TO 7
  440.         TAGLIST VARPTR(tags&(i&*2)), _
  441.             PM_Item&, mpi&(i&), _
  442.             TAG_DONE&
  443.     NEXT i&
  444.  
  445.     MakeTestMenu& = PM_MakeMenuA&(VARPTR(tags&(0)))
  446.  
  447. END FUNCTION
  448.